﻿namespace CSP

module Solving =

    open System.Linq
    open System.Collections.Generic
    open CSP.Domain
    open CSP.Problem

    let private getState init update problem =
        problem.Domains |> Map.toList |> List.filter (fun (_,d) -> count d = 1) |> List.fold (fun s (k,d) -> update k (single d) s) init

    module WQ = CSP.Utils.WorkQueue

    let private reduce st update check problem =
        let queue = List.append 
                        problem.Constraints
                        (List.map (fun (l, c, r) -> r, (fun x y -> c y x), l) problem.Constraints)
                    |> WQ.create (fun (_,_,r) -> r)
        let ds = new Dictionary<_,_>(problem.Domains)
        let rec red st =
            match WQ.next queue with
                | None -> true
                | Some lcr ->
                    let l,c,r = lcr
                    let left = ds.[l]
                    let right = ds.[r]
                    let f st' left' =
                        ds.[l] <- left'
                        WQ.reopen l queue
                        red st'
                    match reduce left c right with
                        | CSP.Domain.Contradiction -> false
                        | NoReduction -> red st
                        | Unique x ->
                            let st' = update l x st
                            if check st' then [x] |> ofList |> f st'
                            else false
                        | Reduced left' -> f st left'
        if red st then Some (create (new Map<_,_>(ds |> Seq.map (fun p -> p.Key, p.Value))) problem.Constraints)
        else None

    /// Finds all solutions of a binary CSP with global checks.
    let rec solve init update check problem =
        let st = getState init update problem
        seq { match reduce st update check problem with
                | None -> yield! Seq.empty
                | Some reduced ->
                    match state reduced with
                    | Contradiction -> yield! Seq.empty
                    | Solution s -> yield s
                    | Ambiguous ds ->
                        let key,_ = ds |> List.minBy (fun (_,d) -> d.Count)
                        let p1, p2 = split key reduced
                        yield! solve init update check p1
                        yield! solve init update check p2 }

    /// Finds one solution of a binary CSP with global checks.
    let find state update check problem = problem |> solve state update check |> Utils.SeqUtils.safeHead

    let internal simpleState = ()
    let internal simpleUpdate _ _ _ = ()
    let internal simpleCheck _ = true

    /// Finds all solutions of a binary CSP without global checks.
    let simpleSolve problem = solve simpleState simpleUpdate simpleCheck problem

    /// Finds one solution of a binary CSP without global checks.
    let simpleFind problem = find simpleState simpleUpdate simpleCheck problem